home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MOTOROLA / 6805V107 / 68705DBG.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-22  |  40KB  |  1,090 lines
  1.         {This module implements the 68705 Instruction Emulator}
  2.         {Revision 1.02    Fixes bugs in the ROL and ROR instructions}
  3.         {Revision 1.03    Displays time to execute programs}
  4. type                                     {Instruction Execution results}
  5.    InstRes     = (Success, Illegal, StopInst, WaitInst, StackError);
  6.  
  7.    BPelement   = record                  {Breakpoint controls}
  8.       movedopc : byte;                       {Displaced opcode}
  9.       location : integer;                    {Its location}
  10.       end;
  11.  
  12. var
  13.    Commandline  : string[255];        {NB Make longer in Original}
  14.    ComPtr       : integer;            {Pointer into Commandline}
  15.    valtab       : array[0..255] of byte; {Collect line-input data}
  16.    valptr       : integer;               {Pointer for above}
  17.    low          : integer;               {Start point for Display}
  18.    BPlist       : array[0..0] of BPelement; {Breakpoint table}
  19.    SimTime      : real;             {Count of machine cycles}
  20.  
  21. const
  22.     ResetVec = -1;                       {Vector locns., offset below MEMMAX}
  23.     SWIVec   = -3;                       {Address the MS byte}
  24.  
  25.    separator : set of char = [' ', ',', ^I];  {Debug command syntax}
  26.  
  27.  
  28. Function memdat(loc :integer) :byte;             {Byte from memory}
  29. begin
  30.    memdat:= memory[loc and memmax];
  31.    end;
  32.  
  33. Procedure showcause(reason :InstRes);            {Report execution failure}
  34. begin
  35.    case reason of
  36.    {  Success:           }          {No report if Success}
  37.       Illegal:     writeln('Illegal Op-Code');
  38.       StopInst:    writeln('STOP Instruction');
  39.       WaitInst:    writeln('WAIT Instruction');
  40.       StackError:  writeln('Stack Over/Underflow');
  41.       end
  42.    end;
  43.  
  44. Function KeyStop : boolean;                      {Handles ^S and ^C}
  45.  
  46.    function testit :char;           {Inner control-key tester}
  47.    var
  48.       x : char;
  49.  
  50.    begin
  51.       if keypressed then begin
  52.          read(kbd,x);               {Pick up the key}
  53.          if x =^C then KeyStop:= true;
  54.          testit:= x;
  55.          end
  56.       else
  57.          testit:= ^L;               {Anything not ^S or ^C}
  58.       end;
  59.  
  60. var
  61.    key : char;
  62.  
  63. begin
  64.    KeyStop:= false;
  65.    key:= testit;
  66.    if key =^S then repeat
  67.       key:= testit;
  68.       until key in [^S, ^C];
  69.    end;
  70.  
  71. Procedure ClearLine;                             {Sets PREFIX to Blanks}
  72. begin
  73.    str(0:78,prefix);
  74.    prefix[78]:= ' ';
  75.    end;
  76.  
  77. Procedure ReportError;                           {Report errors in Command}
  78. begin
  79.    writeln('Command error: type "H <CR>" for Help');
  80.    end;
  81.  
  82. Procedure PassGap;                               {Skip whitespace, etc.}
  83. begin
  84.    while Commandline[ComPtr] in separator do ComPtr:= ComPtr+1;
  85.    end;
  86.  
  87. Function Getvalue(var ans :integer) :boolean;    {Get hex. value}
  88. begin
  89.    Getvalue:= false;                             {Check legal hex. no.}
  90.    ans     := 0;
  91.    while hex(Commandline[ComPtr]) >= 0 do begin
  92.       Getvalue:= true;
  93.       ans:= (ans shl 4) + hex(Commandline[ComPtr]);
  94.       ComPtr:= ComPtr+1;
  95.       end;
  96.    PassGap;
  97.    end;
  98.  
  99. Function Getaddr (var x : integer) : boolean;    {Get & validate an address}
  100. begin
  101.    if Getvalue(x) then Getaddr:= (x >= 0) and (memmax >= x)
  102.                   else Getaddr:= false;
  103.    end;
  104.  
  105. Function Getbytes : boolean;                     {Get list of bytes to table}
  106. var
  107.    temp : integer;
  108.    OK   : boolean;
  109.  
  110. begin
  111.    valptr:= 0;
  112.    OK    := true;
  113.    while OK and (Commandline[ComPtr] <> CR) do begin
  114.       if Getvalue(temp) then begin               {Get a value}
  115.          if hi(temp) =0 then begin
  116.             valtab[valptr]:= lo(temp);
  117.             valptr:= valptr+1;
  118.             end
  119.          else
  120.             OK:= false;
  121.          end
  122.       else
  123.          OK:= false;
  124.       end;
  125.    Getbytes:= OK;
  126.    end;
  127.  
  128. Function Getrange(var start, ending :integer) :boolean; {Get legal range}
  129. begin
  130.    if Getvalue(start) then begin
  131.       Getrange:= true;                           {Got start value}
  132.       if Commandline[ComPtr] ='L' then begin     {Range by Length}
  133.          ComPtr:= ComPtr+1;                      {Pass the "L"}
  134.          PassGap;                                {And any following whitespace}
  135.          Getrange:= Getvalue(ending);
  136.          ending:= ending + start -1;             {Start & Ending inclusive}
  137.          end
  138.       else if Commandline[ComPtr] =CR then begin
  139.          ending:= start + 127;                   {No span - default 128}
  140.          if ending > memmax then ending:= memmax;
  141.          end
  142.       else
  143.          Getrange:= Getvalue(ending);            {Explicit start & end}
  144.          if not ((start >= 0) and                {Range validation}
  145.                  (ending >= start) and
  146.                  (memmax >= ending))  then Getrange:= false;
  147.       end
  148.    else
  149.       Getrange:= false;                          {Input error}
  150.    end;
  151.  
  152. Procedure GetLine(full :boolean);   {Read the Command Line}
  153. begin
  154.    clreol;
  155.    if full then write('>');
  156.    readln(Commandline);
  157.    if Commandline ='' then Commandline:= ' ';
  158.    for ComPtr:= 1 to length(Commandline) do             {Case insensitive}
  159.        Commandline[ComPtr]:= upcase(Commandline[ComPtr]);
  160.    CommandLine:= Commandline + CR;
  161.    if full then begin
  162.       ComPtr:= 2;
  163.       while Commandline[ComPtr] in upper do ComPtr:= ComPtr+1;
  164.       end
  165.    else
  166.       ComPtr:= 1;                   {If subsidiary call, read everything}
  167.    PassGap;                         {To first significant field}
  168.    end;
  169.  
  170. function hardware :CRTptr;        {CRT page base, via hardware}
  171. const
  172.    monochrome =7;
  173.  
  174.    Dmode : byte = monochrome;     {Typed consts. in CS (Turbo-3}
  175.    Dpage : byte = 0;              {They WILL be altered at run-time}
  176.  
  177. begin
  178.    inline (                       {Access the ROM to find Monitor type}
  179.            $55/                   {Push BP        }
  180.            $B4/$0F/               {Mov AH,0F      }
  181.            $CD/$10/               {Int 10 - CRT   }
  182.            $2E/                   {CS:            }
  183.            $A2/Dmode/             {Mov [Dmode],AL }
  184.            $2E/                   {CS:            }
  185.            $88/$3E/Dpage/         {Mov [Dpage],BH }
  186.            $5D );                 {Pop BP         }
  187.  
  188.    if (Dmode =monochrome) then
  189.       hardware:= Ptr($B000, 0)
  190.    else
  191.       hardware:= Ptr(($B800 + Dpage*256), 0);
  192.    end;
  193.  
  194.  
  195. {********* R E G I S T E R - D I S P L A Y   F U N C T I O N *************}
  196. const
  197.    Hflag = $10;          {Condition-Code bit values}
  198.    Iflag = 8;
  199.    Nflag = 4;
  200.    Zflag = 2;
  201.    Cflag = 1;
  202.  
  203.    TDR   = 8;            {Locn. of Timer Data Reg.}
  204.    TCR   = 9;            {Locn. of Timer Control Reg.}
  205.  
  206. var                      {The actual machine registers}
  207.     AReg,                   {Accumulator}
  208.     XReg,                   {Index Reg.}
  209.     SReg,                   {Stack Pointer}
  210.     CReg : byte;            {Condition-code Reg.}
  211.     PReg : integer;         {Program Counter}
  212.  
  213. Procedure IntzRegs;      {Cold-Start setups for Register functions}
  214. begin                    {i.e. Simulate a Machine Reset}
  215.    PReg:= (memory[memmax+ResetVec] shl 8) + memory[memmax+ResetVec+1];
  216.    SReg:= StackTop;                                   {Reset Stack Ptr.}
  217.    memory[TCR]:= memory[TCR] and $7f or $40;          {TCR7:= 0, TCR6:= 1}
  218.    memory[4]:= 0;
  219.    memory[5]:= 0;                                     {All DDR's to Input}
  220.    memory[6]:= 0;
  221.    memory[7]:= 0;
  222.    CReg     := CReg or Iflag or $e0;                  {Interrupts masked}
  223.    end;
  224.  
  225.  
  226. Procedure DisplayAllRegisters;     {Standard display line - Used also by Trace}
  227. const
  228.    flagnames : array[1..5] of char = ('H', 'I', 'N', 'Z', 'C');
  229.  
  230. type
  231.    RSize = (isbyte, isword);          {Register Size}
  232.    leads = string[2];
  233.  
  234.    Procedure OneReg(name :leads; regto :integer; howbig :RSize);
  235.    begin
  236.       hexword(1,regto);                               {Make it hex.}
  237.       lowvideo;
  238.       write(name);
  239.       highvideo;
  240.       if howbig = isbyte then write(copy(prefix,3,2))
  241.                          else write(copy(prefix,1,4)); {Write byte or word}
  242.       write('  ');                                     {2 blanks after}
  243.       end;
  244.  
  245. var
  246.    flagmask : byte;
  247.    flagcnt  : integer;
  248.  
  249. const
  250.    instlen  : array[0..15] of byte = (3,2,2,2,1,1,2,1,1,1,2,2,3,3,2,1);
  251.  
  252. begin
  253.    write('       ');                            {Set-over on line}
  254.    prefix[0]:= chr(16);                         {Room to display}
  255.    OneReg('A=',AReg,isbyte);
  256.    OneReg('X=',XReg,isbyte);
  257.    OneReg('P=',PReg,isword);
  258.    prefix:= '[@@ -- --]  ';
  259.    hexbyte(2,memdat(PReg+0));                   {Show 3 bytes after P reg}
  260.    flagcnt:= instlen[(memdat(PReg) shr 4) and 15];
  261.    if flagcnt > 1 then hexbyte(5,memdat(PReg+1));
  262.    if flagcnt = 3 then hexbyte(8,memdat(PReg+2));
  263.    lowvideo;
  264.    write(prefix);
  265.    OneReg('S=',SReg,isbyte);
  266.    OneReg('C=',CReg,isbyte);                    {Registers, in Hex.}
  267.    lowvideo;
  268.    write('[ ');                                 {Ready for Conditions}
  269.    flagmask:= Hflag;                            {Test mask for 1st flag}
  270.    for flagcnt:= 1 to 5 do begin
  271.       if (CReg and flagmask) =0 then lowvideo
  272.                                 else highvideo; {Display mode}
  273.       write(flagnames[flagcnt], ' ');
  274.       flagmask:= flagmask shr 1;
  275.       end;
  276.    lowvideo;
  277.    writeln(']');
  278.    highvideo;
  279.    end;
  280.  
  281. Procedure DisplayRegisters;                     {The Display Regs. command}
  282. var
  283.    temp : integer;
  284.  
  285.    procedure EditReg(var reg :byte);
  286.    begin
  287.       prefix:= ' @@: ';
  288.       hexbyte(2,reg);
  289.       write(Commandline[ComPtr], prefix);       {Display current value}
  290.       GetLine(false);                           {Use Command Line for data}
  291.       if CommandLine[ComPtr] <> CR then begin
  292.          if GetValue(temp) then begin
  293.             if hi(temp) =0 then reg:= temp      {Good value - set Reg.}
  294.                            else ReportError;
  295.             end
  296.          else
  297.             ReportError;
  298.          end
  299.       end;
  300.  
  301. begin
  302.    case Commandline[ComPtr] of                  {Which register?}
  303.       ^M  : DisplayAllRegisters;
  304.       'A' : EditReg(AReg);
  305.       'X' : EditReg(XReg);
  306.       'P' : begin
  307.                prefix:= ' @@@@: ';
  308.                hexword(2,PReg);
  309.                write(Commandline[ComPtr], prefix);     {Display current value}
  310.                GetLine(false);                     {Use Command Line for data}
  311.                if CommandLine[ComPtr] <> CR then begin
  312.                   if GetValue(temp) then PReg:= temp   {Good value - set Reg.}
  313.                                     else ReportError;
  314.                   end
  315.                end;
  316.       'S' : EditReg(SReg);
  317.       'C' : EditReg(CReg);
  318.       else  ReportError;
  319.       end
  320.    end;
  321.  
  322. {**************************************************************************}
  323.  
  324. {***** I N S T R U C T I O N - E X E C U T I O N   E M U L A T O R ********}
  325.  
  326. Function OneInstruction :InstRes;        {Execute one instruction - result}
  327. type
  328.    byteptr = ^byte;
  329.  
  330. var
  331.    opptr   : byteptr;                     {Can point to Memory or Register}
  332.    localop : array[0..2] of byte;         {Local copy of Instr.}
  333.    x,
  334.    msn,                                   {Most & Least significant opcode nibbles}
  335.    lsn,
  336.    opaddr  : integer;                     {Addr. in Memory of operand}
  337.    bitmask : byte;                        {Used by the Bit instructions}
  338.  
  339.  
  340. Procedure PUSH (x :byte);                  {Push X to Stack: check overflow}
  341. begin
  342.    if SReg < StackBottom then
  343.       OneInstruction := StackError
  344.    else begin
  345.       memory[SReg]:= x;
  346.       SReg:= SReg -1;
  347.       end
  348.    end;
  349.  
  350. Function POP :byte;                        {Pop a byte off Stack: check underflow}
  351. begin
  352.    if SReg < StackTop then begin
  353.       SReg:= SReg +1;
  354.       POP := memory[SReg];
  355.       end
  356.    else OneInstruction:= StackError;
  357.    end;
  358.  
  359. Function extend(x :byte) :integer;         {Sign extension}
  360. begin
  361.    if (x and $80) =0 then extend:= x
  362.                      else extend:= x + $ff00;
  363.    end;
  364.  
  365. Function bytad (var x :byte) :byteptr;     {Returns the adrress of "x"}
  366. begin                                      {Must use "var", to get ptr.}
  367.    bytad:= Ptr(Seg(x), Ofs(x));
  368.    end;
  369.  
  370. Procedure Arithop (result :integer; CYlit, CYdata, saveans :boolean);
  371. begin                                           {Basic Operations}
  372.    if saveans then opptr^ := lo(result);        {Always sets N and Z flags}
  373.    if (result and $80) =0 then CReg:= CReg and not Nflag
  374.                           else CReg:= CReg or Nflag;
  375.    if       lo(result) =0 then CReg:= CReg or Zflag
  376.                           else CReg:= CReg and not Zflag;
  377.    if not CYlit then begin
  378.       if CYdata then CYdata:= (result and $ff00) <> 0
  379.                 else CYdata:= (CReg and Cflag) <> 0;
  380.       end;                                 {C flag is set by variable means}
  381.    if CYdata then CReg:= CReg or Cflag
  382.              else CReg:= CReg and not Cflag;
  383.    end;
  384.  
  385. const                                      {Branch-condition selectors}
  386.    branchtest : array[0..7] of byte = (0,3,1,2,$10,4,8,0);
  387.  
  388. var
  389.    tempres : integer;                      {Partial result in instruction}
  390.    halfcar : byte;                         {Holds the half-carry}
  391.  
  392. begin                                      {Start of OneInstruction}
  393.    for x:= 0 to 2 do localop[x]:= memory[(PReg+x) mod memmax];
  394.    msn:= (localop[0] shr 4) and 15;
  395.    lsn:= localop[0] and 15;
  396.    with ExTable[msn] do begin
  397.       if cycles[lsn] >0 then begin         {Check its a legal opcode}
  398.          OneInstruction:= Success;
  399.          SimTime:= SimTime + cycles[lsn];  {Advance cycle counter}
  400.          PReg:= PReg +bytes;               {Advance Instr. pointer}
  401.          case admode of                    {Addressing modes}
  402.             BTB:  begin
  403.                      opaddr:= localop[1];
  404.                      opptr := bytad(memory[opaddr]);
  405.                      end;
  406.             BSC:  begin
  407.                      opaddr:= localop[1];
  408.                      opptr := bytad(memory[opaddr]);
  409.                      end;
  410.             REL:  begin
  411.                      opaddr:= PReg+ extend(localop[1]);
  412.                      opptr := bytad(memory[opaddr]);
  413.                      end;
  414.             IMM:  begin
  415.                      opaddr:= PReg -1;
  416.                      opptr := bytad(memory[opaddr]);
  417.                      end;
  418.             DIR:  begin
  419.                      opaddr:= localop[1];
  420.                      opptr := bytad(memory[opaddr]);
  421.                      end;
  422.             EXT:  begin
  423.                      opaddr:= (localop[1] shl 8) + localop[2];
  424.                      opptr := bytad(memory[opaddr]);
  425.                      end;
  426.             IX:   begin
  427.                      opaddr:= XReg;
  428.                      opptr := bytad(memory[opaddr]);
  429.                      end;
  430.             IX1:  begin
  431.                      opaddr:= XReg + localop[1];
  432.                      opptr := bytad(memory[opaddr]);
  433.                      end;
  434.             IX2:  begin
  435.                      opaddr:= XReg + (localop[1] shl 8) + localop[2];
  436.                      opptr := bytad(memory[opaddr]);
  437.                      end;
  438.             INHX:    opptr := bytad(XReg);
  439.             INHA:    opptr := bytad(AReg);
  440.             end;                             {End the CASE}
  441.  
  442.          case opclass of                     {Now execute the Instruction}
  443.  
  444.             BitTest: begin                   {BIT TEST & BRANCH}
  445.                bitmask:= 1 shl (lsn div 2);
  446.                if (opptr^ and bitmask) <>0 then CReg:= CReg or Cflag
  447.                                            else CReg:= CReg and not Cflag;
  448.                                              {Conditional Branch}
  449.                if ((CReg and Cflag) <>0) xor odd(lsn) then
  450.                   PReg:= PReg + extend(localop[2]);
  451.                end;
  452.  
  453.             BitSetClr : begin                {BIT SET / CLEAR}
  454.                bitmask:= 1 shl (lsn div 2);
  455.                if odd(lsn) then opptr^ := opptr^ and not bitmask
  456.                            else opptr^ := opptr^ or bitmask;
  457.                end;
  458.  
  459.             BranchRel : begin                {CONDITIONAL, RELATIVE BRANCH}
  460.                if ((CReg and branchtest[lsn div 2]) =0) xor odd(lsn) then
  461.                   PReg:= opaddr;
  462.                end;
  463.  
  464.             RdModWrt  : begin                {READ/MODIFY/WRITE GROUP}
  465.                case lsn of                   {Operations}
  466.                    0: Arithop(-opptr^,                 false, true,  true);
  467.                    3: Arithop(not opptr^,              true,  true,  true);
  468.                    4: Arithop((opptr^ shr 1) and 127,  true,  odd(opptr^), true);
  469.                    6: begin
  470.                          if ((CReg and Cflag) <>0) then tempres:= opptr^ + 256
  471.                                                    else tempres:= opptr^;
  472.                          Arithop(tempres shr 1,        true,  odd(opptr^), true);
  473.                          end;
  474.                    7: Arithop(extend(opptr^) shr 1,    true,  odd(opptr^), true);
  475.                    8: Arithop(opptr^ shl 1,            true,  (opptr^ > 127), true);
  476.                    9: begin
  477.                          tempres:= CReg and 1;  {Carry bit}
  478.                          Arithop((opptr^ shl 1)+tempres, true, (opptr^ > 127), true);
  479.                          end;
  480.                   10: Arithop(opptr^ -1,               false, false, true);
  481.                   12: Arithop(opptr^ +1,               false, false, true);
  482.                   13: Arithop(opptr^,                  false, false, true);
  483.                   15: Arithop(0,                       false, false, true);
  484.                   end                     {End the R-M-W Case}
  485.                end;                       {End the R-M-W main block}
  486.  
  487.             Control: begin                   {CONTROL OPERATIONS GROUP}
  488.                case localop[0] of               {Miscellaneous - direct opcode}
  489.                   $80: begin                       {RTI}
  490.                           CReg:= POP;
  491.                           AReg:= POP;
  492.                           XReg:= POP;
  493.                           PReg:= POP;              {PReg needs 2 bytes}
  494.                           PReg:= (PReg shl 8) + POP;
  495.                           end;
  496.                   $81: begin                       {RTS}
  497.                           PReg:= POP;
  498.                           PReg:= (PReg shl 8) + POP;
  499.                           end;
  500.                   $83: begin                       {SWI}
  501.                           PUSH (lo(PReg));
  502.                           PUSH (hi(PReg));
  503.                           PUSH (XReg);
  504.                           PUSH (AReg);
  505.                           PUSH (CReg);
  506.                           CReg:= CReg or Iflag;    {Interrupts OFF}
  507.                           PReg:= (memory[memmax+SWIVec] shl 8) +
  508.                                   memory[memmax+SWIVec+1];
  509.                           end;
  510.                   $8E: begin                       {STOP}
  511.                           OneInstruction:= StopInst;
  512.                           CReg:= CReg and not Iflag;
  513.                           end;
  514.                   $8F: begin                       {WAIT}
  515.                           OneInstruction:= WaitInst;
  516.                           CReg:= CReg and not Iflag;
  517.                           end;
  518.                   $97: XReg:= AReg;                {TAX}
  519.                   $98: CReg:= CReg and not Cflag;  {CLC}
  520.                   $99: CReg:= CReg or Cflag;       {SEC}
  521.                   $9A: CReg:= CReg and not Iflag;  {CLI}
  522.                   $9B: CReg:= CReg or Iflag;       {SEI}
  523.                   $9C: SReg:= $7F;                 {RSP}
  524.               {   $9D:                              NOP}
  525.                   $9F: AReg:= XReg;                {TXA}
  526.                   end
  527.                end;
  528.  
  529.             RegMem: begin                    {REGISTER - MEMORY GROUP}
  530.                   tempres:= opptr^;               {Get operand}
  531.                   opptr  := bytad(AReg);          {Most results -> A}
  532.                   case lsn of
  533.                      0 : Arithop(AReg-tempres,     false, true,  true );
  534.                      1 : Arithop(AReg-tempres,     false, true,  false);
  535.                      2 : Arithop(Areg-tempres-
  536.                                 (CReg and Cflag),  false, true,  true );
  537.                      3 : Arithop(XReg-tempres,     false, true,  false);
  538.                      4 : Arithop(AReg and tempres, false, false, true );
  539.                      5 : Arithop(AReg and tempres, false, false, false);
  540.                      6 : Arithop(tempres,          false, false, true );
  541.                      7 : begin
  542.                             opptr:= bytad(memory[opaddr]);
  543.                             Arithop(AReg,          false, false, true );
  544.                             end;
  545.                      8 : Arithop(AReg xor tempres, false, false, true );
  546.                      9 : begin
  547.                             halfcar:= ((AReg and 15) +
  548.                                        (tempres and 15) +
  549.                                        (CReg and Cflag) ) and Hflag;
  550.                             Arithop(AReg+tempres+
  551.                                 (CReg and Cflag),  false, true,  true );
  552.                             CReg:= (CReg and not Hflag) + halfcar;
  553.                             end;
  554.                     $A : Arithop(AReg or tempres,  false, false, true );
  555.                     $B : begin
  556.                             halfcar:= ((AReg and 15) +
  557.                                        (tempres and 15)) and Hflag;
  558.                             Arithop(AReg + tempres, false, true,  true );
  559.                             CReg:= (CReg and not Hflag) + halfcar;
  560.                             end;
  561.                     $C : PReg:= opaddr;
  562.                     $D : begin                     {Subroutine Jumps}
  563.                             if msn =$a then        {Relative call}
  564.                                opaddr:= PReg + extend(localop[1]);
  565.                             PUSH (lo(PReg));
  566.                             PUSH (hi(PReg));       {Stacked old P}
  567.                             PReg:= opaddr;         {Jump to S/R}
  568.                             end;
  569.                     $E : begin
  570.                             opptr:= bytad(XReg);
  571.                             Arithop(tempres,       false, false, true );
  572.                             end;
  573.                     $F : begin
  574.                             opptr:= bytad(memory[opaddr]);
  575.                             Arithop(XReg,          false, false, true);
  576.                             end
  577.                   end
  578.                end
  579.             end                              {End the OPCLASS Case}
  580.          end
  581.       else  OneInstruction:= Illegal;
  582.       end
  583.    end;                                      {End of Function OneInstruction}
  584.  
  585.  
  586. {***********************************************************************
  587.  
  588.            E M U L A T O R   C O M M A N D   R O U T I N E S
  589.  
  590.  ***********************************************************************}
  591.  
  592. procedure DoNothing;              {Just a null function}
  593. begin
  594.    end;
  595.  
  596. {******************************************************}
  597.  
  598. procedure AdditionInHex;          {Hexadecimal addition}
  599. var
  600.    x, y  : integer;               {The 2 arguments}
  601.    OK    : boolean;
  602.  
  603. begin
  604.    OK:= false;
  605.    if Getvalue(x) then begin
  606.       if Getvalue(y) then begin
  607.          OK:= true;               {Good input - proceed}
  608.          prefix:= 'Sum: @@@@,  Diff: @@@@';
  609.          hexword( 6, x+y);
  610.          hexword(19, x-y);
  611.          writeln(prefix);
  612.          end
  613.       end;
  614.    if not OK then ReportError;
  615.    end;
  616.  
  617. {******************************************************}
  618.  
  619. procedure CompareMemoryBlocks;    {Compare two blocks}
  620. var
  621.    start, ending, second : integer;
  622.  
  623. begin
  624.    ClearLine;
  625.    prefix[0]:= chr(20);           {Prepare a short line for output}
  626.    if Getrange(start,ending) then begin
  627.       if Getaddr(second) then begin         {Get & verify input}
  628.          while (second <= memmax) and
  629.                (start  <= ending ) and
  630.                (not KeyStop ) do begin
  631.             if memory[start] <> memory[second] then begin  {Differs!}
  632.                hexword( 1,start);
  633.                hexbyte( 7,memory[start]);
  634.                hexbyte(11,memory[second]);
  635.                hexword(15,second);
  636.                writeln(prefix);
  637.                end;
  638.             start := start +1;
  639.             second:= second +1;
  640.             end
  641.          end
  642.       else
  643.          ReportError;
  644.       end
  645.    else
  646.       ReportError;
  647.    end;
  648.  
  649. {******************************************************}
  650.  
  651. procedure DisplayMemory;          {Display in Hex. and Char. formats}
  652. var
  653.    colpos,                                    {Position in display line}
  654.    high       : integer;                      {Display upper limit}
  655.  
  656. Procedure InnerDisplay;
  657. begin
  658.    repeat
  659.       ClearLine;
  660.       prefix[31]:= '-';                       {Group separator}
  661.       prefix[ 5]:= ':';                       {Address delimiter}
  662.       hexword(1,low);                         {Start address}
  663.       repeat                                  {Fill up line data}
  664.          colpos:= low mod 16;                 {Posn. in line}
  665.          hexbyte((colpos*3)+8, memory[low]);  {Display, hex. & ASCII}
  666.          if chr(memory[low]) in [' '..'~'] then
  667.             prefix[colpos+57]:= chr(memory[low])
  668.          else
  669.             prefix[colpos+57]:= '.';
  670.          low:= low+1;                         {Next loxn.}
  671.          until ((low mod 16) =0) or (low > high);
  672.       write(copy(prefix,1,56));
  673.       lowvideo;  write('[');  highvideo;
  674.       write(copy(prefix,57,16));
  675.       lowvideo;  writeln(']'); highvideo;
  676.       until low > high;
  677.    end;
  678.  
  679. begin                                {Display function, proper}
  680.    if Commandline[ComPtr] =CR then begin
  681.       high:= low +127;               {No bounds given: default}
  682.       if high > memmax then high:= memmax;
  683.       InnerDisplay;
  684.       end
  685.    else if GetRange(low,high) then
  686.       InnerDisplay
  687.    else ReportError;
  688.    end;
  689.  
  690. {******************************************************}
  691.  
  692. procedure EnterNewData;           {One byte at a time}
  693. var
  694.    posn,                          {Locn. in Memory}
  695.    column   : integer;            {Display column no.}
  696.    entry    : char;               {Character entered}
  697.  
  698.    Function EnterKey :char;       {ENTER responses: hex. handled internally}
  699.    var
  700.       cct   : integer;            {Step count for hex. processing}
  701.       inch  : char;               {Character input}
  702.  
  703.    begin
  704.       cct:= 1;
  705.       repeat
  706.          read(kbd,inch);          {Get key: no echo, no edit}
  707.          inch:= upcase(inch);
  708.          if hex(inch) >= 0 then begin   {Actions for hex. digit}
  709.             case cct of
  710.                1: begin
  711.                      memory[posn]:= hex(inch);
  712.                      write(inch);
  713.                      end;
  714.                2: begin
  715.                      memory[posn]:= (memory[posn] shl 4) + hex(inch);
  716.                      write(inch);
  717.                      end;
  718.                end;               {End of the CASE}
  719.             cct:= cct+1;
  720.             end;
  721.          until inch in [' ', '-', CR];
  722.       if inch =CR then writeln
  723.                   else write(inch);
  724.       EnterKey:= inch;
  725.       end;
  726.  
  727. begin                             {The command proper}
  728.    ClearLine;
  729.    if Getaddr(posn) then begin
  730.       if Commandline[ComPtr] =CR then begin        {Single-byte mode}
  731.          repeat
  732.             clreol;
  733.             hexword(1,posn);
  734.             write(copy(prefix,1,4), ':');
  735.             column:= 8;
  736.             repeat
  737.                gotoxy(column,wherey);              {Posn. for display}
  738.                hexbyte(1,memory[posn]);
  739.                write(copy(prefix,1,2), '.');       {Show current value}
  740.                entry:= EnterKey;                   {Hex. handled internally}
  741.                if entry =' ' then begin
  742.                   posn:= posn+1;
  743.                   column:= column+8;               {To next point in line}
  744.                   end
  745.                else begin
  746.                   posn:= posn-1;                   {In case "-" entered}
  747.                   column:= 100;                    {Force end-line}
  748.                   end;
  749.                until (column > 64) or (posn > memmax);
  750.             writeln;
  751.             until (entry =CR) or (posn > memmax); {The only other char is CR}
  752.          end
  753.       else begin
  754.          if Getbytes then                          {Multiple byte-values on line}
  755.             for column:= 0 to valptr-1 do
  756.                memory[posn+column]:= valtab[column]
  757.          else ReportError;
  758.          end
  759.       end
  760.    else ReportError;
  761.    end;
  762.  
  763. {******************************************************}
  764.  
  765. procedure FillMemory;             {Fill with a pattern}
  766. var
  767.    start, ending, datptr : integer;
  768.    OK                    : boolean;
  769.  
  770. begin
  771.    OK:= Getrange(start,ending);   {Get & validate data}
  772.    OK:= OK and Getbytes;          {NB Use 3 separate stmts., to guarantee}
  773.    OK:= OK and (valptr >0);       {   order of execution}
  774.    if OK then begin
  775.       datptr:= 0;
  776.       while start <= ending do begin
  777.          if datptr >= valptr then datptr:= 0;
  778.          memory[start]:= valtab[datptr];
  779.          start := start +1;
  780.          datptr:= datptr +1;
  781.          end
  782.       end
  783.    else
  784.       ReportError;
  785.    end;
  786.  
  787. {******************************************************}
  788.  
  789. procedure GoRunProgram;           {Run, with optional Breakpoints}
  790. var
  791.    breakptr,
  792.    hold,
  793.    start      :integer;           {Starting point}
  794.    onbreak,
  795.    goodcmd    :boolean;
  796.    rotary     :array[0..14] of integer; {Rotary traceback table}
  797.    rotptr     :integer;
  798.    ending     :InstRes;
  799.    dummy      :char;
  800.  
  801. const
  802.    breakcode  :byte = $af;        {Illegal instr., as breakpoint}
  803.  
  804. begin
  805.    goodcmd:= true;
  806.    start  := PReg;
  807.    if Commandline[ComPtr] ='=' then begin
  808.       ComPtr := ComPtr +1;        {Skip the "="}
  809.       goodcmd:= GetAddr(start);   {Read the start}
  810.       end;
  811.       breakptr:= 0;
  812.    if GetAddr(hold) then begin
  813.       repeat
  814.          with BPlist[breakptr] do location:= hold;
  815.          breakptr:= breakptr +1;
  816.          until (not GetAddr(hold)) or (breakptr >9);
  817.       end;
  818.    if (Commandline[ComPtr] <> CR) or (not goodcmd) then
  819.       ReportError
  820.    else begin
  821.       for hold:= 0 to breakptr-1 do
  822.          with BPlist[hold] do begin        {Set up breakpoints}
  823.             movedopc        := memory[location];
  824.             memory[location]:= breakcode;
  825.             end;
  826.       SimTime:= 0;                         {Initialise cycle counter}
  827.       for rotptr:= 0 to 15 do rotary[rotptr]:= -1; {Clear traceback table}
  828.       rotptr:= 0;
  829.       PReg:= start;                        {Ready to go...}
  830.       repeat
  831.          rotary[rotptr]:= PReg;
  832.          rotptr:= (rotptr +1) mod 15;      {Traceback}
  833.          ending:= OneInstruction;          {Do once}
  834.          until (ending <> Success) or keypressed;
  835.       if keypressed then read(kbd,dummy);  {Drop dummy keystroke}
  836.       ClearLine;                           {Blank line for traceback}
  837.       writeln(SimTime:8:0, ' Cycles Elapsed... Instruction Trace-Back:');
  838.       for hold:= 0 to 14 do begin
  839.          if rotary[rotptr] >= 0 then hexword(1 + 5*hold, rotary[rotptr]);
  840.          rotptr:= (rotptr+1) mod 15;
  841.          end;
  842.       writeln(prefix);                     {Write the traceback}
  843.       onbreak:= false;
  844.       if ending = Illegal then             {Search breakpoint table}
  845.          for hold:= 0 to breakptr-1 do
  846.             with BPlist[hold] do
  847.                if location = PReg then onbreak:= true;
  848.       if onbreak then begin
  849.          writeln('Breakpoint');
  850.          for hold:= 0 to breakptr-1 do
  851.             with BPlist[hold] do           {Cancel breakpoints}
  852.                memory[location]:= movedopc;
  853.          end
  854.       else
  855.          Showcause(ending);
  856.       DisplayAllRegisters;
  857.       end
  858.    end;
  859.  
  860. {******************************************************}
  861.  
  862. procedure HelpOnScreen;           {Write the Emulator HELP messages}
  863. var
  864.    holdup : char;
  865.  
  866.    procedure Comline(lt, rt :filename); {Formatted HELP line}
  867.    var
  868.       ptr  : integer;
  869.  
  870.    begin
  871.       writeln;
  872.       highvideo;
  873.       ptr:= 1;                           {Start scan of Command}
  874.       repeat
  875.          write(lt[ptr]);
  876.          lowvideo;
  877.          ptr:= ptr+1;
  878.          until lt[ptr-1] =' ';
  879.  
  880.       while ptr <= length(lt) do begin
  881.          if lt[ptr] in [',' , '='] then highvideo;
  882.          write(lt[ptr]);
  883.          lowvideo;
  884.          ptr:= ptr+1;
  885.          end;
  886.       highvideo;
  887.       write(' ':(26-length(lt)));
  888.       write(rt);
  889.       end;
  890.  
  891. begin
  892.    window(1,1,80,25);
  893.    savewindow(debugwind);         {Save the old window}
  894.    promptline('{Hit any key to return to Emulator}');
  895.  
  896.    if firsthelp then begin            {First HELP - set up the display}
  897.       firsthelp:= false;
  898.       firstscreen;
  899.       clrscr;
  900.       writeln('    E M U L A T O R   C O M M A N D S');
  901.       lowvideo;
  902.       writeln('<value> or <addr> = hexadecimal string');
  903.       writeln('<range> = <addr>,<addr> or <addr>L<value>');
  904.       writeln('<regname> = A X P S C');
  905.       writeln('Cmnds. may be abbreviated to 1 letter');
  906.       writeln(' but must be delimited by a non-alpha');
  907.       writeln('<space> and "," are equivalent');
  908.       writeln('[..] =optional,  {..} =may be repeated');
  909.       highvideo;
  910.       writeln('Command Syntax            Function');
  911.       Comline('Add value ,value',       'Hex. addition');
  912.       Comline('Compare range ,addr',    'Compare memory');
  913.       Comline('Display range',          'Display memory');
  914.       Comline('Enter addr [{,value}]',  'Show/alter memory');
  915.       Comline('Fill range {,value}',    'Fill mem. block');
  916.       Comline('Go [=addr] [{,addr}]',   'Run, & breakpoints');
  917.       Comline('Help ',                  'Show this screen');
  918.       Comline('Move range ,addr',       'Move block in Mem.');
  919.       Comline('Quit ',                  'Exit to Main Menu');
  920.       Comline('Register [regname]',     'Show/alter Regs.');
  921.       Comline('Search range {,value}',  'Search for data');
  922.       Comline('Trace [=addr] [,value]', 'Run & display');
  923.       Comline('View ',                  'File-Viewer Window');
  924.  
  925.       savewindow(helpwind);       {Once window set up, save it}
  926.       end
  927.    else
  928.       showwindow(helpwind);       {Subsequent calls - use fast-load}
  929.  
  930.    read(kbd,holdup);              {Wait for some key}
  931.    pulldebug(true);               {Then put DEBUG back}
  932.    end;
  933.  
  934. {******************************************************}
  935.  
  936. procedure MoveMemoryBlock;        {Move a block in memory}
  937. var
  938.    start, ending, second : integer;
  939.  
  940. begin
  941.    if Getrange(start,ending) then begin
  942.       if Getaddr(second) then begin
  943.          while (second <= memmax) and
  944.                (start  <= ending ) do begin
  945.             memory[second]:= memory[start];
  946.             start := start +1;
  947.             second:= second +1;
  948.             end
  949.          end
  950.       else
  951.          ReportError;
  952.       end
  953.    else
  954.       ReportError;
  955.    end;
  956.  
  957. {******************************************************}
  958.  
  959. procedure RegisterSet;            {Display & change Registers}
  960. begin
  961.    DisplayRegisters;
  962.    end;
  963.  
  964. {******************************************************}
  965.  
  966. procedure SearchForString;        {Seek pattern in memory}
  967. var
  968.    start, ending, subpt : integer;
  969.    OK                   : boolean;
  970.  
  971. begin
  972.    OK:= Getrange(start,ending);   {Get & validate data}
  973.    OK:= OK and Getbytes;          {NB Use 3 separate stmts., to guarantee}
  974.    OK:= OK and (valptr >0);       {   order of execution}
  975.    if OK then begin
  976.       ending:= ending +1 -valptr; {Don't search undersize strings}
  977.       repeat
  978.          subpt:= 0;               {Look for match}
  979.          while (subpt < valptr) and
  980.                (memory[start + subpt] = valtab[subpt]) do subpt:= subpt +1;
  981.          if subpt = valptr then begin   {Matched!}
  982.             prefix[0]:= chr(4);
  983.             hexword(1,start);
  984.             writeln(prefix);
  985.             end;
  986.          start:= start +1;
  987.          until KeyStop or (start > ending);
  988.       end
  989.    else
  990.       ReportError;
  991.    end;
  992.  
  993. {******************************************************}
  994.  
  995. procedure TraceExecution;           {Machine emulation with Trace}
  996. var
  997.    goodcmd :boolean;
  998.    start,                     {Start address}
  999.    tracect :integer;          {Trace count}
  1000.    ending  :InstRes;
  1001.  
  1002. begin
  1003.    start  := PReg;
  1004.    tracect:= 1;
  1005.    goodcmd:= true;
  1006.    if Commandline[ComPtr] ='=' then begin
  1007.       ComPtr := ComPtr +1;     {Pass the "="}
  1008.       goodcmd:= GetAddr(start);
  1009.       end;
  1010.    if Commandline[ComPtr] in digit then begin
  1011.       tracect:= 0;
  1012.       while Commandline[ComPtr] in digit do begin
  1013.          tracect:= tracect*10 + ord(Commandline[ComPtr]) -ord('0');
  1014.          ComPtr:= ComPtr+1;
  1015.          end;
  1016.       PassGap;
  1017.       end;
  1018.    if Commandline[ComPtr] <> CR then goodcmd:= false;
  1019.    if goodcmd then begin      {The TRACE proper}
  1020.       PReg:= start;
  1021.       repeat
  1022.          ending:= OneInstruction;
  1023.          DisplayAllRegisters;
  1024.          tracect:= tracect -1;
  1025.          until (tracect <= 0) or (ending <> Success);
  1026.       showcause(ending);      {Report fault, if any}
  1027.       end
  1028.    else
  1029.       ReportError;
  1030.    end;
  1031.  
  1032. {********************* Emulator Mainline ***********************}
  1033. begin
  1034.    if (listname <> Nofile) then begin
  1035.       assign(viewfile,listname);        {Get the Viewer file}
  1036.       {$I-}
  1037.       reset(viewfile);                  {Use LSTFILE - be sure it exists}
  1038.       {$I+}
  1039.       if (IOResult =0) then
  1040.          close(viewfile)  {Let Viewer open properly}
  1041.       else begin
  1042.          writeln('Cannot open Viewer file');
  1043.          listname:= Nofile;             {Open failed}
  1044.          end
  1045.       end;
  1046.  
  1047.    if (listname <> Nofile) then Viewer(Initz);   {Set up the Viewer module}
  1048.    IntzRegs;                      {Simulates a machine reset}
  1049.    with BPlist[0] do location:= -1;   {Empty B-P table}
  1050.    low:= 0;                       {Default for Display function}
  1051.    firsthelp:= true;
  1052.    CRTbase  := hardware;          {Set up CRT base pointer}
  1053.    highvideo;
  1054.    window(1,1,80,25);             {No Turbo window}
  1055.    clrscr;                        {Screen initialisations}
  1056.    lowvideo;
  1057.    gotoxy(1,baseline);
  1058.    clreol;                        {Base-line in Low video}
  1059.    CRTbase^[baseline, 1,character]:= horline; {Fixups at ends}
  1060.    CRTbase^[baseline,80,character]:= horline;
  1061.    hbar(baseleft, baseright);
  1062.    pulldebug(false);
  1063.    writeln('Emulator Ready: type "H <CR>" for Help');
  1064.  
  1065.    repeat                         {Now run the Emulator}
  1066.       GetLine(true);                    {Read & tidy command line}
  1067.       case commandline[1] of
  1068.          ' ' : DoNothing;
  1069.          'A' : AdditionInHex;
  1070.          'C' : CompareMemoryBlocks;
  1071.          'D' : DisplayMemory;
  1072.          'E' : EnterNewData;
  1073.          'F' : FillMemory;
  1074.          'G' : GoRunProgram;
  1075.          'H' : HelpOnScreen;
  1076.          'M' : MoveMemoryBlock;
  1077.          'Q' : DoNothing;         {'Q' will end the REPEAT}
  1078.          'R' : RegisterSet;
  1079.          'S' : SearchForString;
  1080.          'T' : TraceExecution;
  1081.          'V' : if (listname <> Nofile) then Viewer(View)
  1082.                                        else writeln('No View-file Attached');
  1083.          else  writeln('Unrecognised Command - Type "H" for Help');
  1084.          end;                     {End of the CASE}
  1085.  
  1086.       until Commandline[1] = 'Q';   {Loop until QUIT}
  1087.       prefix:= '';
  1088.       if (listname <> Nofile) then Viewer(Finish);
  1089.    end;
  1090.